---
title: "NEON4CAST Dashboard"
output:
  flexdashboard::flex_dashboard:
    theme: 
      version: 4
      bootswatch: lux
    orientation: columns
    vertical_layout: fill
    source_code: embed
---

```{r setup, include=FALSE}

knitr::opts_chunk$set(message=FALSE, error=FALSE, 
                      warning = FALSE, fig.showtext=TRUE)

library(flexdashboard)
library(thematic)
library(clock)

library(plotly)
library(ggiraph)

library(dbplyr)
library(RSQLite)
library(duckdb)
library(tidyverse)
library(neon4cast)

source("R/plotly_helpers.R")

thematic::thematic_rmd(font = "auto")
```


Home
=====



```{r include=FALSE}
combined <- read_csv("https://data.ecoforecast.org/analysis/combined_forecasts_scores.csv.gz")
```


Column {data-width=650}
-----------------------------------------------------------------------


### NEON Ecological Forecasting Challenge sites

```{r}
## FIXME color code by number of challenges at each site?

challenges <- combined %>% select(theme, siteID) %>% distinct() %>%
  separate(siteID, into = c("siteID", "plot")) %>%
  select(theme, siteID) %>% 
  distinct() 
  
library(sf)
library(tmap)

if(!file.exists("neon_sites.rds")){
geo <- jsonlite::read_json("https://github.com/eco4cast/neon4cast/raw/main/inst/extdata/geo.json", TRUE)
site_id <- gsub(", .*$", "", geo$geographicDescription)
bb <- geo$boundingCoordinates[1:4] %>% mutate_all(as.numeric) %>% mutate(siteID = site_id)
bb <- left_join(bb, challenges, by = "siteID")
neon <- st_as_sf(bb, coords = c("westBoundingCoordinate", "northBoundingCoordinate"), crs = 4326)
saveRDS(neon, "neon_sites.rds")
} else {
  neon <- readRDS("neon_sites.rds")
}

tmap::tmap_mode("view")
tm_shape(neon) + tm_dots(col="theme", alpha=.4, size = .1)
```

Column {data-width=350}
-----------------------------------------------------------------------

## Stats

### Challenges 


```{r}
flexdashboard::valueBox(5, color = "primary")
```

### Teams

```{r}
total_teams <- combined %>% select(team) %>% distinct() %>% count()
flexdashboard::valueBox(total_teams, color = "success")
```



### Total Forecasts

```{r}
total_forecasts <- combined %>% select(team, forecast_start_time) %>% distinct() %>% count()
flexdashboard::valueBox(total_forecasts, color = "info")
```





Phenology
==========


Column {data-width=650}
-----------------------------------------------------------------------

### Forecasts


#### Phenology

```{r}
## determine these more cleverly
start <- as.Date("2021-05-01")
end <- Sys.Date() %>% clock::add_months(1)

## Get most recent submission per team
pheno_teams <- combined %>% filter(theme == "phenology") %>%
  select(team, forecast_start_time) %>% distinct() %>%
  group_by(team) %>%
  slice_max(forecast_start_time)

pheno_latest <- inner_join(pheno_teams, combined)

p <- pheno_latest %>% 
  filter(time > start, time < end, target == "gcc_90") %>%
  ggplot() +
  geom_ribbon(aes(x = time, ymin = lower95, ymax = upper95, fill = team), alpha = 0.2) +
  geom_line(aes(time, mean, col = team)) +
  geom_point(aes(time, obs), size = .1) + 
  facet_wrap(~siteID)+ ggtitle("Greeness")

gp <- plotly::ggplotly(p)
gp <- patch_legend(gp)

gp
```



```{r}
p <- pheno_latest %>% 
  filter(time > start, time < end, target == "rcc_90") %>%
  ggplot() +
  geom_ribbon(aes(x = time, ymin = lower95, ymax = upper95, fill = team), alpha = 0.2) +
  geom_line(aes(time, mean, col = team)) +
  geom_point(aes(time, obs), size = .1) + 
  facet_wrap(~siteID) + ggtitle("Redness")

gp <- plotly::ggplotly(p)
gp <- patch_legend(gp)

gp
```


```{r}
null_filled <- combined %>% 
  filter(theme == "phenology", target == "gcc_90") %>% 
  fill_scores()
```


```{r}
scores <- null_filled %>%
  mean_scores() 
```


```{r}
A <- null_filled %>% 
  collect() %>% 
  mutate(time = as.Date(time), 
         forecast_start_time  = as.Date(forecast_start_time),
         horizon = as.integer(time - forecast_start_time))

best <- head(scores$team, n=6)
```

### Scores

#### Score by horizon 

(top 6 teams)

```{r}
p <- A %>%
  group_by(theme, target, team, horizon) %>%  # average over siteID
  summarise(mean_crps = mean(filled_crps, na.rm =TRUE),
            .groups = "drop") %>%
  filter(team %in% best) %>%
  ggplot(aes(horizon, mean_crps, col=team)) + 
  geom_point() + facet_grid(~target) 

plotly::ggplotly(p)
```

#### Scores over time

```{r}
p <- A %>%
  group_by(theme, target, team, time) %>%  # average over siteID
  summarise(mean_crps = mean(filled_crps, na.rm =TRUE),
            .groups = "drop") %>% 
  filter(team %in% best) %>%
  ggplot(aes(time, mean_crps, col=team)) + 
  geom_line() + facet_grid(~target)
plotly::ggplotly(p)

```

#### Scores by site

```{r}
p  <- A %>%
  group_by(theme, target, team, siteID) %>%  # average over siteID
  summarise(mean_crps = mean(filled_crps, na.rm =TRUE),
            .groups = "drop") %>% 
  filter(team %in% best) %>%
  ggplot(aes(team, mean_crps, fill=siteID)) + 
  geom_col(position="dodge") + scale_fill_viridis_d()

plotly::ggplotly(p)

  
```



Column {data-width=350}
-----------------------------------------------------------------------

### Days remaining

```{r}
pheno_end_date <- as.Date("2021-12-31")
pheno_start_date <- as.Date("2021-02-01")
days <- (pheno_end_date - Sys.Date() ) 
max <- pheno_end_date - pheno_start_date
gauge(days, min = 0, max = max, symbol = '', gaugeSectors(
  success = c(81, max), warning = c(10, 3), danger = c(0, 2)
))
```



### Teams

```{r}
total <- combined %>% filter(theme == "phenology") %>% select(team) %>% distinct() %>% count()
flexdashboard::valueBox(total)
```

### Leaderboard (target: greeness)

```{r}
scores %>% filter(target == "gcc_90") %>% select(-target) %>% rmarkdown::paged_table(scores)
```

### Leaderboard (Fall redness)

```{r}
combined %>% 
  filter(theme == "phenology", target == "rcc_90") %>% 
  fill_scores(null_team = "climatology") %>% mean_scores() %>%
  rmarkdown::paged_table()

```


Aquatics
========

Column {data-width=650}
-----------------------------------------------------------------------


### Aquatics Forecasts

```{r}

start <- as.Date("2021-05-31")
end <- as.Date("2021-08-31")

## Get most recent submission per team
aq_teams <- combined %>% filter(theme == "aquatics") %>%
  select(team, forecast_start_time) %>% distinct() %>%
  group_by(team) %>%
  slice_max(forecast_start_time)

## Heck show all the forecasts
p <- combined %>% #inner_join(aq_teams) %>%
  filter(theme == "aquatics", time >= start, time <= end) %>%
  ggplot() +
  geom_ribbon(aes(x = time, ymin = lower95, ymax = upper95, fill = team), alpha = 0.2) +
  geom_point(aes(time, obs)) + 
  geom_line(aes(time, mean, col = team)) +
  facet_grid(target~siteID, scales = "free")

gp <- plotly::ggplotly(p)
gp <- patch_legend(gp)

gp
```


### Scores

```{r}
null_filled <- combined %>% 
  filter(theme == "aquatics") %>% 
  fill_scores()
```


```{r}
scores <- null_filled %>%
  mean_scores() 

```


```{r}
A <- null_filled %>% 
  collect() %>% 
  mutate(time = as.Date(time), 
         forecast_start_time  = as.Date(forecast_start_time),
         horizon = as.integer(time - forecast_start_time))

best <- head(scores$team, n=6)
```


#### Score by horizon 

(top 6 teams)

```{r}
p <- A %>%
  group_by(theme, target, team, horizon) %>%  # average over siteID
  summarise(mean_crps = mean(filled_crps, na.rm =TRUE),
            .groups = "drop") %>%
  filter(team %in% best) %>%
  ggplot(aes(horizon, mean_crps, col=team)) + 
  geom_point() + facet_wrap(~target, scales="free")

ggplotly(p)
```

#### Scores over time

```{r}
p <- A %>%
  group_by(theme, target, team, time) %>%  # average over siteID
  summarise(mean_crps = mean(filled_crps, na.rm =TRUE),
            .groups = "drop") %>% 
  filter(team %in% best) %>%
  ggplot(aes(time, mean_crps, col=team)) + 
  geom_line() + facet_wrap(~target, scales="free")
ggplotly(p)

```

#### Scores by site

```{r}
p <- A %>%
  group_by(theme, target, team, siteID) %>%  # average over siteID
  summarise(mean_crps = mean(filled_crps, na.rm =TRUE),
            .groups = "drop") %>% 
  filter(team %in% best) %>%
  ggplot(aes(team, mean_crps, fill=siteID)) + 
  geom_col(position="dodge") + scale_fill_viridis_d() + 
  facet_wrap(~target, scales = "free")
ggplotly(p)

  
```






Column {data-width=350}
-----------------------------------------------------------------------

### Teams

```{r}
total <- combined %>% filter(theme == "aquatics") %>% select(team) %>% distinct() %>% count()
flexdashboard::valueBox(total)
```

### Days elapsed

```{r}
days <- end-start
gauge(days, min = 0, max = end-start, symbol = '', gaugeSectors(
  success = c(11, as.numeric(end-start)), warning = c(10, 3), danger = c(0, 2)
))
```


### Leaderboard

```{r}
rmarkdown::paged_table(scores)

```

Terrestrial
===========

Column {data-width=650}
-----------------------------------------------------------------------

### Terrestrial Forecasts (Daily)

```{r}
## Could consider displaying older ones
start <- combined %>% 
  filter(theme == "terrestrial_daily") %>%
  select(forecast_start_time) %>% 
  distinct() %>% 
  arrange(desc(forecast_start_time))

p <- combined %>%
  filter(theme == "terrestrial_daily", forecast_start_time == start[[2,1]]) %>%
  ggplot() +
  geom_ribbon(aes(x = time, ymin = lower95, ymax = upper95, fill = team), alpha = 0.2) +
  geom_line(aes(time, mean, col = team)) +
  geom_point(aes(time, obs)) + 
  facet_grid(target ~ siteID, scales = "free")

gp <- plotly::ggplotly(p)
gp <- patch_legend(gp)

gp
```


### Terrestrial Forecasts (30 minute)

```{r}
## Could consider displaying older ones
start <- combined %>% 
  filter(theme == "terrestrial_30min") %>%
  select(forecast_start_time) %>% 
  distinct() %>% 
  arrange(desc(forecast_start_time))

p <- combined %>%
  filter(theme == "terrestrial_30min", forecast_start_time == start[[2,1]]) %>%
  ggplot() +
  geom_ribbon(aes(x = time, ymin = lower95, ymax = upper95, fill = team), alpha = 0.2) +
  geom_line(aes(time, mean, col = team)) +
  geom_point(aes(time, obs)) + 
  facet_grid(target ~ siteID, scales = "free")

gp <- plotly::ggplotly(p)
gp <- patch_legend(gp)

gp
```

Column {data-width=350}
-----------------------------------------------------------------------


### Teams: `terrestrial_daily`

```{r}
total <- combined %>% filter(theme == "terrestrial_daily") %>%
  select(team) %>% distinct() %>% count()
flexdashboard::valueBox(total)
```

### Teams: `terrestrial_30min`

```{r}
total <- combined %>% filter(theme == "terrestrial_30min") %>% 
  select(team) %>% distinct() %>% count()
flexdashboard::valueBox(total)
```



### Leaderboard (daily)

```{r}
combined %>% 
  filter(theme == "terrestrial_daily") %>%
  group_by(team) %>%
  summarise(mean_crps = mean(crps,na.rm=TRUE)) %>%
  arrange(mean_crps) %>%
  rmarkdown::paged_table()
```
### Leaderboard (30 minute)

```{r}
combined %>% 
  filter(theme == "terrestrial_30min") %>%
  group_by(team) %>%
  summarise(mean_crps = mean(crps,na.rm=TRUE)) %>%
  arrange(mean_crps) %>%
  rmarkdown::paged_table()
```

Ticks
=======

Column {data-width=650}
-----------------------------------------------------------------------




### Ticks

```{r}
## Could consider displaying older ones
start <- combined %>% 
  filter(theme == "ticks") %>%
  select(forecast_start_time) %>% 
  distinct() %>% 
  arrange(desc(forecast_start_time))

p <- combined %>%
  filter(theme == "ticks", forecast_start_time == start[[2,1]]) %>% # second most recent start time
  ggplot() +
  geom_ribbon(aes(x = time, ymin = lower95, ymax = upper95, 
                  fill = team, lty=target), alpha = 0.2) +
  geom_line(aes(time, mean, col = team, lty=target)) +
  geom_point(aes(time, obs, shape=target)) + 
  facet_wrap(~siteID, scales = "free")


## ggiraph also supports ggplot-syntax-based controls
ggiraph(ggobj = p)


```


Column {data-width=350}
-----------------------------------------------------------------------


### Teams

```{r}
total <- combined %>% filter(theme == "ticks") %>% 
  select(team) %>% distinct() %>% count()
flexdashboard::valueBox(total)
```



### Leaderboard

```{r}
combined %>% 
  filter(theme == "ticks") %>%
  group_by(team) %>%
  summarise(mean_crps = mean(crps,na.rm=TRUE)) %>%
  arrange(mean_crps) %>%
  rmarkdown::paged_table()
```


Beetles
=======

Column {data-width=650}
-----------------------------------------------------------------------

### Beetles Forecasts

```{r fig.width=8, fig.height=16}
## determine these more cleverly
start <- combined %>% 
  filter(theme == "beetles") %>%
  select(forecast_start_time) %>% 
  distinct() %>% 
  arrange(desc(forecast_start_time))

p <- combined %>%
  filter(theme == "beetles", 
         target == "richness",
         forecast_start_time == start[[1,1]]) %>% # second most recent start time
  ggplot() +
  geom_ribbon(aes(x = time, ymin = lower95, ymax = upper95, fill = team), alpha = 0.2) +
  geom_line(aes(time, mean, col = team)) +
  geom_point(aes(time, obs)) + 
  facet_wrap(~siteID, scales = "free")

ggiraph(ggobj = p)


```


Column {data-width=350}
-----------------------------------------------------------------------


### Teams

```{r}
total <- combined %>% filter(theme == "ticks") %>% 
  select(team) %>% distinct() %>% count()
flexdashboard::valueBox(total)
```


### Leaderboard

```{r}
combined %>% 
  filter(theme == "beetles") %>%
  group_by(team) %>%
  summarise(mean_crps = mean(crps,na.rm=TRUE)) %>%
  arrange(mean_crps) %>%
  rmarkdown::paged_table()
```